pca_wish_dims_wish_rels
Haroon Popal
12/18/2020
if(!require(FactoMineR)) install.packages("FactoMineR"); require(FactoMineR)## Loading required package: FactoMineRif(!require(factoextra)) install.packages("factoextra"); require(factoextra)## Loading required package: factoextra## Loading required package: ggplot2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary(psych)##
## Attaching package: 'psych'## The following objects are masked from 'package:ggplot2':
##
## %+%, alphalibrary(ggplot2)
if(!require(reshape)) install.packages("reshape"); require(reshape)## Loading required package: reshapelibrary(cowplot)##
## Attaching package: 'cowplot'## The following object is masked from 'package:reshape':
##
## stamplibrary(stringr)
if(!require(plotly)) install.packages("plotly"); require(plotly)## Loading required package: plotly##
## Attaching package: 'plotly'## The following object is masked from 'package:reshape':
##
## rename## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutsetwd("C:/Users/Administrator/Google_Drive/olson_lab/projects/relationship_knowledge/results/wish_replication/")
#setwd("~/Google_Drive/olson_lab/projects/relationship_knowledge/results/wish_replication/")
getwd()## [1] "C:/Users/Administrator/Google_Drive/olson_lab/projects/relationship_knowledge/results/wish_replication"# import that relationship dimension ratings from the python output
dim_rel_scaled = read.csv('dim_rel_scaled.csv', row.names=1)
rownames(dim_rel_scaled) <- str_replace(rownames(dim_rel_scaled), "â\200“", "-")
png(filename="pca_results/parallel_analysis.png")
fa.parallel(dim_rel_scaled,fa="pc")## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done
## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done
## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done## Warning in cor.smooth(r): Matrix was not positive definite, smoothing was done## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.## In factor.scores, the correlation matrix is singular, an approximation is used## Warning in cor.smooth(r): Matrix was not positive definite, smoothing was done## Parallel analysis suggests that the number of factors = NA and the number of components = 2dev.off()## png
## 2fa.parallel(dim_rel_scaled,fa="pc")## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done
## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done## Warning in cor.smooth(r): Matrix was not positive definite, smoothing was done## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.## In factor.scores, the correlation matrix is singular, an approximation is used## Warning in cor.smooth(r): Matrix was not positive definite, smoothing was done
## Parallel analysis suggests that the number of factors = NA and the number of components = 2# Run PCA with no rotation
res.pca_nor <- PCA(dim_rel_scaled, ncp=4, graph=FALSE)
write.csv(res.pca_nor$var$coord, file = 'pca_results/pca_loadings_nrotate.csv')
write.csv(res.pca_nor$ind$coord, file = 'pca_results/pca_relationships_nrotate.csv')
# Create screeplot
png(filename="pca_results/scree_plot.png")
fviz_screeplot(res.pca_nor) + ggtitle("") +
theme(text = element_text(size = 20))
dev.off()## png
## 2fviz_screeplot(res.pca_nor) + ggtitle("") +
theme(text = element_text(size = 20))
pv <- principal(dim_rel_scaled, 4, rotate="varimax")## Warning in cor.smooth(r): Matrix was not positive definite, smoothing was done## Warning in principal(dim_rel_scaled, 4, rotate = "varimax"): The matrix is not
## positive semi-definite, scores found from Structure loadingspv$loadings <- pv$loadings[ order(row.names(pv$loadings)), ][ , order(colnames(pv$loadings)) ]
write.csv(pv$loadings, file = 'pca_results/pca_loadings_varimax.csv')
write.csv(pv$scores, file = 'pca_results/pca_relationships_varimax.csv')
print(paste0("First four components account for ",
round(pv$Vaccounted[3,4], digits = 4)*100,
"% of the variance"))## [1] "First four components account for 94.36% of the variance"loadings_var <- cbind(melt(as.matrix(as.data.frame(pv$loadings[,1:4]))), "Varimax")
colnames(loadings_var)[4] <- 'Rotation'
ggplot(data = loadings_var, aes(x = X2, y = X1)) +
geom_tile(aes(fill = value)) +
scale_fill_distiller(palette="RdBu", limits=c(-1,1)) +
ggtitle("Varimax PCA Loadings") +
ylab("Wish Dimensions") +
theme_minimal() +
theme(text = element_text(size = 12), axis.title.x=element_blank()) 
ggsave('pca_results/pca_loadings_varimax.png')## Saving 7 x 5 in imagecomp1_loadings <- loadings_var[loadings_var$X2=='RC1',]
print(cat('Component 1 highest positive loadings:',
gsub('\\.', ' ', toString(comp1_loadings[comp1_loadings$value > 0.5,]$X1))))## Component 1 highest positive loadings: Altruistic vs Selfish, Compatible vs incompatible goals and desires, Cooperative vs Competitive, Democratic vs Autocratic, Easy vs Difficult to resolve conflicts with each other, Emotionally close vs distant, Fair vs Unfair, Flexible vs Rigid, Friendly vs Hostile, Harmonious vs Clashing, Important vs Unimportant to individuals involved, Important vs Unimportant to society, Productive vs Destructive, Relaxed vs Tense, Sincere vs InsincereNULLprint(cat('\nComponent 1 highest negative loadings:',
gsub('\\.', ' ', toString(comp1_loadings[comp1_loadings$value < -0.5,]$X1))))##
## Component 1 highest negative loadings: NULLcomp2_loadings <- loadings_var[loadings_var$X2=='RC2',]
print(cat('\nComponent 2 highest positive loadings:',
gsub('\\.', ' ', toString(comp2_loadings[comp2_loadings$value > 0.5,]$X1))))##
## Component 2 highest positive loadings: Difficult vs Easy to break off contact with each other, Emotional vs Intellectual, Emotionally close vs distant, Informal vs Formal, Intense vs Superficial feelings toward each other, Intense vs Superficial interaction with each other, Interesting vs Dull, Pleasure vs Work orientedNULLprint(cat('\nComponent 2 highest negative loadings:',
gsub('\\.', ' ', toString(comp2_loadings[comp2_loadings$value < -0.5,]$X1))))##
## Component 2 highest negative loadings: NULLcomp3_loadings <- loadings_var[loadings_var$X2=='RC3',]
print(cat('\nComponent 3 highest positive loadings:',
gsub('\\.', ' ', toString(comp3_loadings[comp3_loadings$value > 0.5,]$X1))))##
## Component 3 highest positive loadings: Democratic vs Autocratic, Equal vs Unequal, Similar vs Different roles and behaviorNULLprint(cat('\nComponent 3 highest negative loadings:',
gsub('\\.', ' ', toString(comp3_loadings[comp3_loadings$value < -0.5,]$X1))))##
## Component 3 highest negative loadings: NULLcomp4_loadings <- loadings_var[loadings_var$X2=='RC4',]
print(cat('\nComponent 4 highest positive loadings:',
gsub('\\.', ' ', toString(comp4_loadings[comp4_loadings$value > 0.5,]$X1))))##
## Component 4 highest positive loadings: Active vs Inactive, Important vs Unimportant to individuals involved, Important vs Unimportant to society, Intense vs Superficial interaction with each other, Interesting vs DullNULLprint(cat('\nComponent 4 highest negative loadings:',
gsub('\\.', ' ', toString(comp4_loadings[comp4_loadings$value < -0.5,]$X1))))##
## Component 4 highest negative loadings: NULLlibrary(dplyr)##
## Attaching package: 'dplyr'## The following object is masked from 'package:reshape':
##
## rename## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union# Import dimension loadings from Wish et al., 1976
wish_dim1 = c(.89, .87, .87, .87, .85, .84, .76, .75, .73, .02, .11,
.12, .10, -.03, .12, .16, -.03, .32, -.13, .40, .42, .47,
.55, .59, .20)
wish_dim2 = c(.04, .04, .04, .06, .04, .05, .04, .22, .07, .96, .91,
.07, .10, .02, .12, .06, .06, .05, -.01, .63, .02, .04,
.10, .14, -.01)
wish_dim3 = c(-.01, .04, .08, .10, .16, .03, .07, .07, .00, .02, .09,
.81, .75, .73, .64, .53, -.08, .14, .22, .00, .64, .36,
.25, .00, .53)
wish_dim4 = c(-.10, -.06, .12, .01, -.06, .04, .24, .13, .29, .03, .02,
-.06, .18, .22, .15, .01, .95, .70, .70, .27, .08, .42,
.40, .43, .43)
wish_loadings <- data.frame(wish_dim1, wish_dim2, wish_dim3, wish_dim4)
wish_loadings$dims <- c('Harmonious.vs.Clashing', 'Cooperative.vs.Competitive', 'Friendly.vs.Hostile',
'Compatible.vs.incompatible.goals.and.desires', 'Productive.vs.Destructive',
'Easy.vs.Difficult.to.resolve.conflicts.with.each.other','Altruistic.vs.Selfish',
'Fair.vs.Unfair', 'Relaxed.vs.Tense', 'Equal.vs.Unequal','Similar.vs.Different.roles.and.behavior',
'Active.vs.Inactive','Intense.vs.Superficial.interaction.with.each.other',
'Intense.vs.Superficial.feelings.toward.each.other','Interesting.vs.Dull',
'Important.vs.Unimportant.to.society','Pleasure.vs.Work.oriented','Informal.vs.Formal',
'Emotional.vs.Intellectual','Democratic.vs.Autocratic','Important.vs.Unimportant.to.individuals.involved',
'Emotionally.close.vs.distant','Sincere.vs.Insincere','Flexible.vs.Rigid',
'Difficult.vs.Easy.to.break.off.contact.with.each.other')
# Rearrange rows so that they match the PCA loadings dataframe
wish_loadings <- wish_loadings %>%
mutate(dims = factor(dims, levels = rownames(pv$loadings[,1:4]))) %>%
arrange(dims)
rownames(wish_loadings) <- wish_loadings$dims
wish_loadings <- wish_loadings[,1:4]
wish_loadings## wish_dim1 wish_dim2
## Active.vs.Inactive 0.12 0.07
## Altruistic.vs.Selfish 0.76 0.04
## Compatible.vs.incompatible.goals.and.desires 0.87 0.06
## Cooperative.vs.Competitive 0.87 0.04
## Democratic.vs.Autocratic 0.40 0.63
## Difficult.vs.Easy.to.break.off.contact.with.each.other 0.20 -0.01
## Easy.vs.Difficult.to.resolve.conflicts.with.each.other 0.84 0.05
## Emotional.vs.Intellectual -0.13 -0.01
## Emotionally.close.vs.distant 0.47 0.04
## Equal.vs.Unequal 0.02 0.96
## Fair.vs.Unfair 0.75 0.22
## Flexible.vs.Rigid 0.59 0.14
## Friendly.vs.Hostile 0.87 0.04
## Harmonious.vs.Clashing 0.89 0.04
## Important.vs.Unimportant.to.individuals.involved 0.42 0.02
## Important.vs.Unimportant.to.society 0.16 0.06
## Informal.vs.Formal 0.32 0.05
## Intense.vs.Superficial.feelings.toward.each.other -0.03 0.02
## Intense.vs.Superficial.interaction.with.each.other 0.10 0.10
## Interesting.vs.Dull 0.12 0.12
## Pleasure.vs.Work.oriented -0.03 0.06
## Productive.vs.Destructive 0.85 0.04
## Relaxed.vs.Tense 0.73 0.07
## Similar.vs.Different.roles.and.behavior 0.11 0.91
## Sincere.vs.Insincere 0.55 0.10
## wish_dim3 wish_dim4
## Active.vs.Inactive 0.81 -0.06
## Altruistic.vs.Selfish 0.07 0.24
## Compatible.vs.incompatible.goals.and.desires 0.10 0.01
## Cooperative.vs.Competitive 0.04 -0.06
## Democratic.vs.Autocratic 0.00 0.27
## Difficult.vs.Easy.to.break.off.contact.with.each.other 0.53 0.43
## Easy.vs.Difficult.to.resolve.conflicts.with.each.other 0.03 0.04
## Emotional.vs.Intellectual 0.22 0.70
## Emotionally.close.vs.distant 0.36 0.42
## Equal.vs.Unequal 0.02 0.03
## Fair.vs.Unfair 0.07 0.13
## Flexible.vs.Rigid 0.00 0.43
## Friendly.vs.Hostile 0.08 0.12
## Harmonious.vs.Clashing -0.01 -0.10
## Important.vs.Unimportant.to.individuals.involved 0.64 0.08
## Important.vs.Unimportant.to.society 0.53 0.01
## Informal.vs.Formal 0.14 0.70
## Intense.vs.Superficial.feelings.toward.each.other 0.73 0.22
## Intense.vs.Superficial.interaction.with.each.other 0.75 0.18
## Interesting.vs.Dull 0.64 0.15
## Pleasure.vs.Work.oriented -0.08 0.95
## Productive.vs.Destructive 0.16 -0.06
## Relaxed.vs.Tense 0.00 0.29
## Similar.vs.Different.roles.and.behavior 0.09 0.02
## Sincere.vs.Insincere 0.25 0.40write.csv(wish_loadings, file = 'pca_results/wish_loadings.csv')# Merge together PCA and wish loadings dataframes
loadings_all_temp <- merge(pv$loadings[,1:4], wish_loadings, by="row.names")
loadings_all <- loadings_all_temp[,-1] # Reset the index to be relationships
rownames(loadings_all) <- loadings_all_temp[,1]
colnames(loadings_all) <- c('RC1','RC2','RC3','RC4',
'Dim1','Dim2','Dim3','Dim4')
# Calculate correlation matrix of all dimensions across all methods
loadings_all.cor = cor(loadings_all, method=c("spearman"))
# Create heatmap plot
loadings_all.cor_melt <- melt(loadings_all.cor)
limit <- max(abs(loadings_all.cor_melt$value)) * c(-1, 1)
ggplot(data = loadings_all.cor_melt, aes(x = X2, y = X1)) +
geom_tile(aes(fill = value)) +
scale_fill_distiller(palette="RdBu", limit=limit) +
ggtitle('Principal Component & Wish Dimension Loadings Comparison') +
theme(text = element_text(size = 8),
plot.title = element_text(color="black", size=14, face="bold", hjust = 0.5),
axis.title.x = element_blank(),
axis.title.y = element_blank())
fig <- plot_ly(as.data.frame(pv$scores), x=~RC1, y=~RC2,
type = "scatter", mode = "markers",
text = rownames(pv$scores),
hoverinfo = "text")
x <- list(title = paste('PC1 (', round(res.pca_nor$eig[1,2], 2), '%)'))
y <- list(title = paste('PC2 (', round(res.pca_nor$eig[2,2], 2), '%)'))
fig <- fig %>% layout(xaxis = x, yaxis = y)
fig## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.Note that the echo = FALSE parameter was added to the code chunk to prevent printing of the R code that generated the plot.